home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / DISM < prev    next >
Encoding:
Text File  |  1992-01-26  |  25.2 KB  |  898 lines
  1.  
  2. \ btd sept 30 86.  fixed odd adr crash, tabs, added cycle calc.
  3. \ 36 sec to compiler from floppy, 28 sec from ram disk.  14,200 bytes. 
  4.  
  5. \ 02-jan-87  mdh  for 1.1 ... NIB4:14 checks if calling thru +64k or ORG before
  6. \                 deciding it is calling within the kernal.  Also, modified
  7. \                 to decode both in DEF.  Also, DEF resets DISM-ORIGIN.
  8.  
  9. \ 05-oct-87  mdh  fixed many problems...relative branch addresses now show
  10. \                 correct value based on DISM-ORIGIN...added RELDISM so that
  11. \                 an address can be DISM'ed relative to another address...
  12. \                 fixed JSR ABS.L to print the called name, if appropriate...
  13. \                 DC.W was not being initialized correctly; if seen, could
  14. \                 screw up next opcode.
  15.  
  16. \ 27-may-88  mdh  NIB11 was using wrong value for checking cmpm.
  17.  
  18. \ 27-feb-89  mdh  NIB4:4 printed MOVE <EA>,ccr arguments in wrong order
  19.  
  20. \ 01-mar-89  mdh  re-instated '.w' size in word arguments (Why taken out?)
  21.  
  22. \ 21-may-89  mdh  LINK must set word-size for operand data (nib4-reg)
  23.  
  24. \ 05-aug-89  mdh  Print ascii values for opcodes if DISM-CYCLES off.
  25.  
  26. \ 00001 25-sep-91 mdh     fix NIB14
  27. \ 00002 30-nov-91 mdh     incorporate Marty Kees' 68881 support
  28. \ 00003 26-dec-91 mdh     some words to FORTH vocab, better DISM control
  29. \ 00004 03-jan-92 mdh/plb removed OF ... ELSE abortions
  30. \ 00005 25-jan-92 mdh     remover USER definitions
  31.  
  32.  
  33. \ ********************** OK, lets get all our tools  ***********************
  34. FALSE .IF
  35.     known bugs: - some timings are inexact. off by as much as 4 cycles.
  36. .THEN
  37.   
  38. FORTH DEFINITIONS
  39. INCLUDE? CONDITION jf:CONDITION
  40. INCLUDE? @BITS jf:@BITS
  41. INCLUDE? SELECT jf:SELECT
  42. INCLUDE? $TABLE jf:$TABLE
  43.  
  44. DECIMAL
  45.  
  46. anew TASK-DISM
  47.  
  48. : dism-words ;
  49.  
  50. .NEED B->S
  51. : B->S   ( BYTE--- N ) 255 AND DUP 127 >
  52.       IF [ 127 COMP ] LITERAL OR   THEN ;
  53. .THEN
  54.  
  55. .NEED >FIG-FLAG
  56. : >FIG-FLAG ( FLAG --- FIG-FLAG-1-OR-0 )  IF 1 ELSE 0 THEN ;
  57. .THEN
  58.  
  59. .NEED ?EVEN
  60. : ?EVEN  ( ADR --- EVEN-ADR )  ( and a warning if odd ) DUP 1 AND 
  61.        IF   CR ." garbage odd address.  incrementing to even" 1+ CR 
  62.        THEN ;
  63. .THEN
  64.  
  65. .NEED FIG-VAR
  66. : FIG-VAR  ( INIT-VALUE --- )  ( WORD --IN-- )
  67.    [] variable ( 00005 )  LATEST   NAME>   EXECUTE  ! ;
  68. .THEN
  69.  
  70.  
  71. .NEED COLUMN
  72. : COLUMN ( column --- )  dup out @ <
  73.   IF   CR
  74.   THEN OUT @ - ABS SPACES ; 
  75. .THEN 
  76.  
  77. \ ********************** ready to start for real! ***********************
  78.  
  79. ONLY FORTH DEFINITIONS 
  80.  
  81. \ start 00003 -- moved to FORTH so 'showhunks' can use DISASSEM.MOD
  82. ( 00005 )  variable DISM-ORIGIN 
  83. true fig-var .REGNAMES?
  84. ( 00005 )  variable  SHOW-CYCLES  SHOW-CYCLES ON
  85. \ end 00003
  86.  
  87. EXISTS? UNCODE
  88. .IF    FORGET UNCODE 
  89. .THEN
  90.  
  91. VOCABULARY UNCODE IMMEDIATE
  92.  
  93. ALSO  FORTH
  94. UNCODE DEFINITIONS
  95.  
  96. DECIMAL
  97. 0 FIG-VAR DISM-ADR
  98. 0 FIG-VAR DISM-SIZE      0 FIG-VAR DISM-DONE
  99. 0 FIG-VAR HIGH-BRANCH    0 FIG-VAR START-ADR
  100. -1 U2/ FIG-VAR LOW-BRANCH
  101. 0 FIG-VAR NEW-DISM-ADR
  102.  
  103.  6 FIG-VAR  ADR.R
  104.  8 FIG-VAR  OPCODE-COL   
  105. 16 FIG-VAR  ARG-COL 
  106. 43 FIG-VAR  CODE-COL 
  107. 60 FIG-VAR  CYCLE-COL 
  108. 74 FIG-VAR  FINAL-COL 
  109.  
  110. : >ARG  ( --- )  ARG-COL @ COLUMN ;
  111.  
  112. ( 00005 )  variable  #CYCLES
  113. ( 00005 )  variable  #CYCLES/
  114. : +CYCLES  ( N --- )  #CYCLES +! ;
  115. : +LONG  ( N --- )  ( add 4 cycles if size long )  DISM-SIZE @ 2 = 
  116.       IF 4 +  THEN +CYCLES ;
  117.  
  118. : LONG?  ( --- FLAG ) DISM-SIZE @ 2 = ; 
  119. : +CYCLES/  ( N --- ) #CYCLES/ +! ;
  120. : +IF-LONG ( CYCLES +IF-LONG --- )  LONG? 
  121.       IF    + 
  122.       ELSE  DROP
  123.       THEN  +CYCLES ;
  124.  
  125. ( 00005 )  variable  MEM
  126. : IS-MEM  ( --- )  MEM ON ;
  127. ( 00005 )  variable  APPROX
  128. : +MEM  ( CYCLE --- )  MEM @ IF DUP +CYCLES THEN DROP  ;
  129.  
  130. : DONE? ( -- )  HIGH-BRANCH @    DISM-ADR @ >  NOT  DISM-DONE !  ;
  131.  
  132. DECIMAL
  133. 0 FIG-VAR OPCODE
  134. : OPP  ( --- OPP-WORD )  OPCODE @ ;
  135.  
  136. : @OPP-BITS  ( OFF #BITS--- N ) >R >R OPP R> R> @BITS ;
  137. : OPP-BIT?  ( BIT# --- FLAG ) OPP SWAP BIT-SET? >FIG-FLAG  ;
  138. : OPP-BITS? CREATE ( BIT# --- )  ,
  139.         DOES>  ( <PFA> --- FLAG )    @ OPP-BIT? >FIG-FLAG  ;
  140.  
  141. 8   OPP-BITS?    8?
  142. 6   OPP-BITS?    6?
  143. 7   OPP-BITS?    7?
  144. 5   OPP-BITS?    5?
  145. 3   OPP-BITS?    3?
  146.  
  147. : 6&7   ( --- VAL )  6 2 @OPP-BITS ;
  148. : 6&7?   ( --- FLAG )  6&7 3 = ;
  149. : OPP/9  ( --- OPP/9  )  OPP 9 -shift ;
  150. : OPP/6  ( --- OPP/6  )  OPP 6 -shift ;
  151. : OPP/3  ( --- OPP/3  )  OPP 3 -shift ;
  152.  
  153. : A2+  ( --- ) 2 DISM-ADR @ + ?EVEN DISM-ADR ! ;
  154. : PAR1 ( --- paramter1 )  DISM-ADR @ 2+ W@ W->S ;
  155. : .#  ." #" ;
  156. : BIN.#  ( --- )  ( binary .IMM , byte-size )
  157.     ." #%" PAR1   0 .R        A2+   ;
  158.  
  159. : .,  ( --- )  ." ," ;
  160.  
  161. \ : CHECK-EA-ABS  ( -- flag , check for valid effective address combos )
  162. \   3 3 @opp-bits 7 =
  163. \   IF    0 3 @opp-bits 2 <
  164. \   ELSE  true
  165. \   THEN  ;
  166. \ 
  167. \ : CHECK-EA-&PC  ( -- flag , check for valid effective address combos )
  168. \   3 3 @opp-bits 7 =
  169. \   IF    0 3 @opp-bits 5 <
  170. \   ELSE  true
  171. \   THEN  ;
  172.  
  173. DECIMAL
  174. : SET-SIZE  ( --- ) 6 2 @OPP-BITS  DISM-SIZE ! ;
  175.  
  176. 4 $TABLE SIZE-TEXT  ".b" ".w" ".l" "?"
  177. : SIZE$  SIZE-TEXT  >ARG  ;
  178. : .SIZE  ( --- ) DISM-SIZE @ 3 MIN SIZE$  ;
  179.  
  180. : .LONG  2 SIZE$  ;
  181. : .WORD  1 SIZE$  ;
  182. : .BYTE  0 SIZE$  ;
  183.  
  184. DECIMAL
  185. : .BASE-CHAR  ( --- )  BASE @
  186.     CASE   16  OF ." $"   ENDOF
  187.             2  OF ." %"   ENDOF
  188.     ENDCASE  ;
  189.  
  190. : .IMM  ( --- )  .#   .BASE-CHAR
  191.      DISM-ADR @ 2+  DISM-SIZE @
  192.      CASE   0   OF  1+   C@    B->S   ENDOF
  193.             1   OF  W@   W->S         ENDOF
  194.             2   OF  @    A2+          ENDOF
  195.      ENDCASE  A2+  0 .R    4 +LONG       ;
  196.  
  197. DECIMAL
  198. 8 $TABLE AREGS
  199.      "a0"     "a1"     "loc"    "+64k"   "org"     "up"   "dsp"   "rp"
  200. 8 $TABLE AREGS-68K
  201.      "a0"     "a1"     "a2"     "a3"     "a4"      "a5"   "a6"    "a7"
  202. 8 $TABLE DREGS
  203.      "d0"     "d1"     "d2"     "d3"     "d4"    "iloop" "jloop"  "tos"
  204. 8 $TABLE DREGS-68K
  205.      "d0"     "d1"     "d2"     "d3"     "d4"      "d5"   "d6"    "d7"
  206.  
  207. DECIMAL
  208. : .AREG  ( opp --- )   7 AND  .REGNAMES? @
  209.   IF   AREGS
  210.   ELSE AREGS-68K
  211.   THEN  ;
  212. : .DREG  ( opp --- )   7 AND  .REGNAMES? @
  213.   IF   DREGS
  214.   ELSE DREGS-68K
  215.   THEN  ;
  216.  
  217. \ 0 CONSTANT DUMMY \ named dummy value for such functions as endcase
  218. \ : .DREG  ( 0-7 --- )   7 AND  
  219. \     CASE    7  OF  ." TOS"   ENDOF
  220. \             6  OF  ." LOOP2" ENDOF
  221. \             5  OF  ." LOOP1" ENDOF 
  222. \       ." D"  0  .R   DUMMY 
  223. \     ENDCASE  ;
  224.  
  225. : .(  ." ("  ;
  226.  
  227. : .)  ." )"  ;
  228. : .AN     ( opp --- )  .AREG     ;
  229. : .A@     ( opp --- )  .( .AREG .)      4 +CYCLES IS-MEM  ;
  230. : .A@+    ( opp --- )  .( .AREG ." )+"  4 +CYCLES IS-MEM  ;
  231. : .-A@   ( opp --  )  ." -(" .AREG .)   6 +CYCLES IS-MEM  ;
  232. : .NUM ( n --- )   .BASE-CHAR  0 .R     ;
  233.  
  234. FALSE FIG-VAR DC.W?
  235. : .DW   ( --- )
  236.   BEGIN  out @  opcode-col @ >
  237.   WHILE  bsout @ emit
  238.   REPEAT ." dc.w " >ARG  OPP .num   DC.W? ON    ;
  239.  
  240. : .PAR1-SIZE ( --- )   PAR1 11 BIT-SET?
  241.    IF    ." .l"
  242.    else  ." .w"
  243.    THEN    ;
  244.  
  245. DECIMAL
  246.  
  247. : IN-DICT?   ( adr -- flag , true if in side image and valid nfa )
  248.   >R  R 0< NOT   R HERE <     AND
  249.   R>  >NAME  VALID-NAME? AND  ;
  250.  
  251. : .ADR  ( ADR --- )  ( ." ADR" )  DISM-ORIGIN  @ -  ADR.R @ .R   ;
  252.  
  253. FALSE FIG-VAR DOING-CALL
  254. : .CALLED-NAME?  ( cfa -- , IF calling a cfa, print name )
  255.   DOING-CALL @  .REGNAMES? @ AND  DISM-ORIGIN @ 0= AND
  256.   IF   OPP JSR+64K-CODE =
  257.        IF  $ 1,0000 +
  258.        THEN DUP IN-DICT?
  259.        IF   DUP ."  = " >NAME ID.
  260.        THEN
  261.   THEN DROP  ;
  262.  
  263. : .ARGS-ADR  ( ADR -- )   \  (this is ABSOLUTE!)  DISM-ORIGIN @ -
  264.   BL  ARG-COL @  EMIT-TO-COLUMN DUP .NUM
  265.   dism-origin @ -  .CALLED-NAME?   ;   
  266.  
  267. : .ARGS-RELADR  ( ADR -- )    DISM-ORIGIN @ -
  268.   BL  ARG-COL @  EMIT-TO-COLUMN DUP .NUM
  269.   dism-origin @ -  .CALLED-NAME?   ;   
  270.  
  271. DECIMAL
  272. : .,R)  ( --- )  .,  PAR1 12 3 @BITS  PAR1 15 BIT-SET? ( OPP-BIT?  ) 
  273.    IF    .AREG
  274.    ELSE  .DREG
  275.    THEN  .PAR1-SIZE  .)  ;
  276.  
  277. : .AN+W    ( opp --- )   PAR1  .NUM  .A@ 
  278.   DISM-ADR @ 2+ W@ W->S    .CALLED-NAME?
  279.   A2+  4 +LONG  IS-MEM  ;
  280.  
  281. : .PAR1   ( --- )  PAR1  B->S .NUM ;
  282.  
  283. : .AN+R+B  ( opp--- ) .PAR1  .( .AREG   .,R)
  284.   A2+  10 +CYCLES IS-MEM  ;
  285.  
  286. : .PC+R+B  (  --- )   .PAR1  ." (pc"    .,r)    A2+  10 +CYCLES IS-MEM ;
  287.  
  288. : .PC+W (  --- )    PAR1 .NUM  ." (pc)"   A2+   8 +CYCLES IS-MEM ;
  289.  
  290. : .ABS.W  ( --- )  PAR1
  291.   >rel .ARGS-RELADR  ." .w"  A2+   8 +CYCLES IS-MEM ;
  292.  
  293. : .ABS.L ( --- )  DISM-ADR @ 2+ @ \ dup   .ARGS-ADR  >rel .CALLED-NAME?
  294.   >rel .ARGS-RELADR  4 DISM-ADR +!  12 +CYCLES  ;
  295.  
  296. : .EXT   ( OPP --- )   7  AND
  297.       SELECT      .ABS.W .ABS.L .PC+W .PC+R+B   .IMM  .DW  .DW  .DW
  298.       END-SELECT   ( --- )  ;
  299.  
  300. : .SOURCE  ( --- )  OPP     3 3  @OPP-BITS
  301.       SELECT     .DREG     .AN       .A@       .A@+
  302.                  .-A@      .AN+W     .AN+R+B   .EXT
  303.       END-SELECT  ( opp selector--- )  ;
  304.  
  305. : ,SOURCE  ., .SOURCE ;
  306.  
  307. : ,AREG    ., .AREG  ;
  308.  
  309. : ,DREG    ., .DREG  ;
  310.  
  311. FALSE FIG-VAR .ED-M
  312. : ?., (  --- )  .ED-M @ IF .,      THEN .ED-M  ON  ;
  313. : ?./ (  --- )  .ED-M @ IF   ." /" THEN .ED-M  ON  ;
  314.  
  315. DECIMAL 
  316. : dismCR?  ( --- )   OUT @ CODE-COL @ 3 - > 
  317.     IF    CR  ARG-COL @ COLUMN   
  318.     THEN ;
  319.  
  320. variable laston  variable lastoff  variable leadchar
  321. variable #seq    variable rtype    variable #mcyc
  322. variable dstart  variable astart   variable .movr'd
  323.  
  324. : .MOVR  ( reg# -- )  rtype @ ascii a -
  325.   IF   .dreg
  326.   ELSE .areg
  327.   THEN .movr'd on dismcr? ;
  328.  
  329. : .leadchar  ( -- )
  330.   leadchar @ ?dup
  331.   IF
  332.      .movr'd @
  333.      IF
  334.         dup emit
  335.      THEN
  336.      drop
  337.   THEN
  338. ;
  339.  
  340. : .on  ( #b -- ) dup laston @ - 1-
  341.   IF   .leadchar  dup .movr  ascii - leadchar !  #seq off
  342.   ELSE 1 #seq +!
  343.   THEN laston !  #mcyc @ dup +IF-LONG  ;
  344.  
  345. : .off ( #b -- )  dup lastoff @ - 1-
  346.   IF   #seq @
  347.        IF   .leadchar  laston @ .movr
  348.        THEN   ascii / leadchar !
  349.   THEN lastoff !  0 #seq !  ;
  350.  
  351. : initmovm   ( char -- )  rtype !
  352.   -10 laston !  -1 lastoff !  leadchar off #seq off  ;
  353.  
  354. : ?last  lastoff @ 2+ .off   ;
  355.  
  356. : .REGLIST  ( par #cycles A-start D-start --- )
  357.   dstart !  astart !  #mcyc !    ascii d  .movr'd off  initmovm   8 0  
  358.   DO   dup  dstart @ i - abs bit-set?  i swap
  359.        IF    .on
  360.        ELSE  .off
  361.        THEN
  362.   LOOP ?last  8 0  ascii a initmovm  ascii / leadchar !
  363.   DO   dup  astart @ i - abs bit-set?  i swap
  364.        IF    .on
  365.        ELSE  .off
  366.        THEN
  367.   LOOP ?last  DROP    ;   DECIMAL
  368.  
  369. : .MOVEM  ( --- )  .ED-M OFF  PAR1  3 3 @OPP-BITS 4 =
  370.   IF   ( A7-A0,D7-D0 )  4  7 15
  371.   ELSE ( d0-d7,a0-a7 )  5 -8  0
  372.   THEN .reglist  a2+  ;
  373.  
  374.  
  375. : NIB4:0   ( --- )   6&7?
  376.      IF     ." move"  .WORD   ." sr,"   6   +CYCLES 
  377.      ELSE   ." negx"  .size             4 2 +IF-LONG 
  378.      THEN  .SOURCE  ;
  379.  
  380. : DISM-CLR  (  --- )  ." clr"  .SIZE  .SOURCE  4 2 +IF-LONG ;
  381.  
  382. : NIB4:4  (  --- )    6&7?
  383.      IF     ." move" .WORD  .SOURCE  ." ,ccr"  ( WRONG? ) 12 +CYCLES
  384.      ELSE   ." neg"  .SIZE  4 2 +IF-LONG .SOURCE
  385.      THEN   ;
  386.  
  387. : NIB4:6   ( --- )   6&7?
  388.      IF      ." move"  .WORD  .SOURCE  ." ,sr"  12 +CYCLES
  389.      ELSE    ." not"   .LONG  .SOURCE           6  +CYCLES  2 +MEM   
  390.      THEN      ;
  391.  
  392. : NIB4:8  ( --- )  6&7
  393.   CASE
  394.    0  OF     ." nbcd"   .BYTE   .SOURCE 6 +CYCLES   2 +MEM  ENDOF
  395.    1  OF     ." pea"  ( .LONG ) >arg .SOURCE 4 +CYCLES           ENDOF
  396.    ." movem" 6? 1+  SIZE$      
  397.     .MOVEM  ., .SOURCE         12   +CYCLES     
  398.   ENDCASE     ;
  399.  
  400. : NIB4:10  (  --- )   6&7?
  401.     IF      ." tas"  .BYTE       6 +MEM  
  402.     ELSE    ." tst"  6&7 SIZE$    
  403.     THEN  .SOURCE   4 +CYCLES ;
  404.  
  405. : NIB4:14   (  --- )  7?
  406.    IF  6?   2 DISM-SIZE ! 
  407.        IF    ." jmp"   DONE?   APPROX ON  
  408.        ELSE  ." jsr"   8 +CYCLES
  409.              \ check if doing a call thru +64k or ORG
  410.              3 3 @OPP-BITS 5 =
  411.              0 3 @OPP-BITS dup 3 = swap 4 = or  ( -- an+w-flag a3-or-a4-flag )
  412.              AND opp $ 4eb9 = or  DOING-CALL !
  413.        THEN  ( .LONG ) >arg .SOURCE
  414.    ELSE   0 4 @OPP-BITS      ." trap"  >ARG  .#  .NUM
  415.    THEN  ;
  416.  
  417. : NIB4:12  (  --- ) ( opp,movem-mask,ext)
  418.    ." movem"  6?  1+   SIZE$    8 +CYCLES  
  419.    DISM-ADR @ >R    (   6?  )  A2+ .SOURCE
  420.    R> DISM-ADR @ >R DISM-ADR !  .,    .MOVEM  
  421.    R> DISM-ADR !  ;
  422.  
  423. : NIB4-UNIQUE  (  --- )    OPP/9 6?
  424.   IF      ." lea"  >ARG    .SOURCE ,AREG    APPROX ON 
  425.   ELSE    ." chk.w"  >ARG  OPP $ 3f and  $ 3c =
  426.           IF
  427.              1 DISM-SIZE !  ( set WORD size )
  428.           THEN
  429.           .SOURCE ,DREG   8 +CYCLES
  430.   THEN   ;
  431.  
  432. : NIB4-SPECIAL ( --- ) 
  433.    OPP $ 100  AND
  434.    IF    NIB4-UNIQUE
  435.    ELSE  ( JMP )  9 3 @OPP-BITS
  436.           SELECT      NIB4:0    DISM-CLR    NIB4:4    NIB4:6
  437.                       NIB4:8    NIB4:10     NIB4:12   NIB4:14
  438.           END-SELECT
  439.    THEN ;
  440.  
  441. DECIMAL
  442. : .NIB4-REG     ( --- )  OPP DUP   $ FFF8 AND CASE
  443.   $ 4E68  OF    ." move"  >ARG  ." usp,"   .AREG   6 +CYCLES 2 +MEM  ENDOF
  444.   $ 4E60  OF    ." move"  >ARG  .AREG    ." ,usp"  4 +CYCLES         ENDOF
  445.   $ 4E58  OF    ." unlk"  >ARG  .AREG             12 +CYCLES         ENDOF
  446.   $ 4880  OF    ." ext"  .WORD .DREG              4 +CYCLES         ENDOF
  447.   $ 4E50  OF    ." link"  >ARG  .AREG .,
  448.                 1 dism-size !   .IMM  18 +CYCLES         ENDOF
  449.   $ 4840  OF    ." swap"  >ARG  .DREG              4 +CYCLES         ENDOF
  450.   $ 48C0  OF    ." ext"  .LONG .DREG              4 +CYCLES         ENDOF
  451.      DROP  NIB4-SPECIAL
  452.   ENDCASE  ;
  453. DECIMAL
  454.  
  455. DECIMAL
  456. : NIB4  ( --- )   OPP
  457. CASE  
  458.   $ 4E76  OF  ." trapv"                4 +CYCLES  ( 34 +IF )  ENDOF
  459.   $ 4E75  OF  ." rts"           DONE? 16 +CYCLES          ENDOF
  460.   $ 4E73  OF  ." rte"           DONE? 20 +CYCLES          ENDOF
  461.   $ 4E72  OF  ." stop"   BIN.#  DONE?  4 +CYCLES          ENDOF
  462.   $ 4E70  OF  ." reset"              123 +CYCLES          ENDOF
  463.   $ 4E71  OF  ." nop"                  4 +CYCLES          ENDOF
  464.   $ 4E77  OF  ." rtr"           DONE? 20 +CYCLES          ENDOF
  465.   $ 4AFA  OF  ." illegal"             34 +CYCLES          ENDOF
  466.   $ 4AFB  OF  ." illegal"             34 +CYCLES          ENDOF
  467.   $ 4AFC  OF  ." illegal"             34 +CYCLES          ENDOF
  468.       .NIB4-REG
  469. ENDCASE  ;
  470.  
  471. : .DEST  ( --- )  OPP  >R
  472.        9 3 @OPP-BITS    OPP/3  $ 38 AND     OR
  473.        OPCODE !   ,SOURCE R> OPCODE  !  ;
  474.  
  475. DECIMAL
  476. : NIB1-3   ( --- )  12 2 @OPP-BITS  4 +CYCLES 
  477.    CASE  1 OF  0  ENDOF  
  478.          2 OF  2  ENDOF
  479.          3 OF  1  ENDOF
  480.        ." illegal move size "  decimal QUIT
  481.    ENDCASE   DISM-SIZE !    
  482.      ." move"  .SIZE
  483.    .SOURCE DC.W? @ NOT
  484.    IF  .DEST  
  485.    THEN   4 +MEM    ;
  486.  
  487. 4 $TABLE  DYN$  "btst"   "bchg"  "bclr"  "bset"
  488.  
  489. : .STAT-BIT  ( --)  0 dism-size !  6&7  DYN$ >ARG
  490.   .IMM ( A2+ -- removed 1/24/87 mdh )
  491.   ,SOURCE ;
  492.  
  493. : NIB0-UNIQUE  ( --- )
  494.   CONDITION   3 3 @OPP-BITS 1 =
  495.       IF    ." movep"   OPP/9  OPP 6? 1+  DISM-SIZE ! .SIZE 7?
  496.             IF    ( REG=>MEM )  .DREG  .,  .AN+W
  497.             ELSE    .AN+W  ,DREG
  498.             THEN   16 8 +IF-LONG 
  499.       ELSE  8?
  500.       IF    6&7 DYN$ >ARG OPP/9 .DREG ,SOURCE  6 2 +IF-LONG  2 +CYCLES/
  501.       ELSE   ." eori"  .SIZE  .IMM ,SOURCE  8 8 +IF-LONG  4 +MEM 
  502.    ENDCOND  ;
  503.  
  504. 7 $TABLE   NIB0$    "or"  "and"  "sub"   "add"  "???"  "eor"  "cmp"
  505.  
  506. : NIB0-DEST  ( --- )  9 3 @OPP-BITS  NIB0$
  507.    .SIZE  .IMM    ,SOURCE  8 8 +IF-LONG  4 +MEM    ;
  508.  
  509. : NIB0   ( --- )   OPP 
  510.   CASE   
  511.    $  3C  OF    ." or"    .BYTE   BIN.# ." ,ccr" ENDOF
  512.    $  7C  OF    ." or"    .WORD   BIN.# ." ,sr"  ENDOF
  513.    $ 23C  OF    ." and"   .BYTE   BIN.# ." ,ccr" ENDOF
  514.    $ 27C  OF    ." and"   .WORD   BIN.# ." ,sr"  ENDOF
  515.    $ A3C  OF    ." eor"   .BYTE   BIN.# ." ,ccr" ENDOF
  516.    $ A7C  OF    ." eor"   .WORD   BIN.# ." ,sr"  ENDOF
  517.      8 4 @OPP-BITS
  518.       SELECT  NIB0-DEST  NIB0-UNIQUE  NIB0-DEST   NIB0-UNIQUE
  519.               NIB0-DEST  NIB0-DEST    NIB0-DEST   NIB0-UNIQUE
  520.               .STAT-BIT  NIB0-UNIQUE  NIB0-UNIQUE NIB0-UNIQUE
  521.               NIB0-DEST  NIB0-UNIQUE  NIB0-UNIQUE NIB0-UNIQUE
  522.       END-SELECT  DROP EXIT 
  523.   ENDCASE  [ DECIMAL ] 20 +CYCLES  ;
  524.  
  525. DECIMAL 
  526. 16 $TABLE .COND$  "ra" "f" "hi" "ls" "cc" "cs" "ne" "eq" "vc" "vs" "pl" "mi" "ge" "lt" "gt" "le"
  527.  
  528.  
  529. : .COND  ( --- )  8 4 @OPP-BITS  .COND$  ;
  530.  
  531. : SET-HIGH-BRANCH ( ADR --- )  HIGH-BRANCH @ MAX HIGH-BRANCH ! ; 
  532.  
  533. : UNCOND-BRA?  ( ADR --- ) >R R  DISM-ADR @ - 50 >
  534.     DONE?  DISM-DONE @   AND  DISM-DONE !
  535.     R@  START-ADR @ < DISM-DONE !  R> SET-HIGH-BRANCH  ;
  536.  
  537. : COND-BRA?  ( ADDR --- )   8 4 @OPP-BITS
  538.   IF     SET-HIGH-BRANCH
  539.   ELSE   UNCOND-BRA?
  540.   THEN ;
  541.  
  542. : NIB5   ( --- )   6&7?
  543.   IF   ( DBCC OR SCC ) OPP  [ BINARY ]  111000 AND 1000 =
  544.          IF    ." db" .COND  .WORD  OPP .DREG  [ DECIMAL ]
  545.                PAR1  DISM-ADR @  +  2+  DUP COND-BRA? ., .ARGS-RELADR
  546.                A2+     10 +CYCLES ( 4 +DID'NT ) 
  547.          ELSE  ." s" .COND >ARG  .SOURCE 4 2 +IF-LONG  APPROX ON
  548.          THEN
  549.   ELSE  ( QUICK )  8?
  550.         IF    ." subq"   
  551.         ELSE  ." addq"  
  552.         THEN  .SIZE  9 3 @OPP-BITS DUP 0=
  553.         IF      8 +
  554.         THEN    .# .NUM   ,SOURCE   4 +LONG  4 +MEM  ( +4 AN ) APPROX ON  
  555.         ( : 2 +MEM-IF-LONG  4 +IF-AN ) 
  556.   THEN  ;
  557.  
  558. : NIB6   ( --- )
  559.    OPP 255 AND 0=
  560.    IF    PAR1   A2+  1 DISM-SIZE !
  561.    ELSE  OPP B->S 2+  0 DISM-SIZE !
  562.    THEN   ( bra-offset )  DISM-ADR @ +  ( DISM-SIZE @ 2* + )
  563.    ( ABS-ADR )   8 4 @OPP-BITS  1 =
  564.    IF    ." bsr"       DOING-CALL ON        18 +CYCLES
  565.    ELSE  ." b" .COND   DUP    COND-BRA?     10 +CYCLES  ( -2 +2 IF-LONG-DID'T)
  566.    THEN  DISM-SIZE @ 
  567.    IF    ." .l"
  568.    ELSE  ." .s"
  569.    THEN  .ARGS-RELADR  ;
  570.  
  571. : .MOVEQ  ( --- )  ." moveq.l" >ARG OPP 255 AND B->S ascii # emit .NUM
  572.      OPP/9  ,DREG  4 +CYCLES    ;
  573.  
  574. DECIMAL
  575. : NIB8  ( --- )
  576.    6&7?
  577.    IF     8?  ." div" 
  578.           IF    ASCII s 158 +CYCLES  
  579.           ELSE  ASCII u 140 +CYCLES 
  580.           THEN  EMIT >ARG  1 dism-size !  .SOURCE  OPP/9  ,DREG   
  581.    ELSE    OPP $ 1F0 AND $ 100 = 
  582.           IF    ." sbcd"  .BYTE OPP/9 OPP  3?
  583.                 IF     .-A@  .,  .-A@ 18 
  584.                 ELSE  .DREG  ,DREG     8
  585.                 THEN  +CYCLES 
  586.           ELSE  ." or" .SIZE   OPP/9   8?
  587.                 IF     .DREG    ,SOURCE   8 2 
  588.                 ELSE   .SOURCE  ,DREG     4 2 
  589.                 THEN   +IF-LONG 
  590.           THEN
  591.    THEN     ;
  592.  
  593. : NIB9  ( --- ) OPP/9
  594.   CONDITION OPP $ C0 AND $ C0 =  ( OPP/9  FLAG )
  595.     IF    ." suba"   8?  1+ DISM-SIZE ! .SIZE  .SOURCE ,AREG 
  596.           8 +CYCLES  -2 +MEM     
  597.     ELSE  OPP $ 130 AND $ 100 =  ( OP/9 FLAG )    8 +CYCLES  APPROX ON 
  598.     IF   ." subx" .SIZE   OPP  3?
  599.          IF      .-A@   .,   .-A@  [ DECIMAL ]     18 12  
  600.          ELSE   .DREG ,DREG                         4 4  
  601.          THEN   +IF-LONG 
  602.     ELSE   ." sub" .SIZE     8? NOT
  603.            IF   ( => EA )  .SOURCE  ,DREG  4 2     
  604.            ELSE  ( ->DN )  .DREG  ,SOURCE  4 2  ( +2 IF DN )  APPROX ON
  605.            THEN  +IF-LONG 
  606.   ENDCOND   ;
  607.  
  608. : NIB11  ( --- ) OPP/9
  609.  CONDITION  6 2 @OPP-BITS  3 =
  610.      IF    ." cmpa"  8? 1+ DISM-SIZE ! .SIZE  .SOURCE ,AREG  6 +CYCLES 
  611.      ELSE  8?   NOT
  612.      IF    ." cmp"  .SIZE .SOURCE  ,DREG   4 2 +IF-LONG
  613.      ELSE  3 3 @OPP-BITS 1 =
  614.      IF    ." cmpm"  .SIZE  OPP   .A@+  .,  .A@+  12 8 +IF-LONG    
  615.      ELSE   ." eor"  .SIZE .DREG ,SOURCE    8 4 +IF-LONG 
  616.  ENDCOND ;
  617.  
  618. DECIMAL
  619. : .MUL  (  --- )  OPP/9   6&7?
  620.     IF    8?
  621.          IF     ." muls"   
  622.          ELSE   ." mulu"
  623.          THEN    >ARG .SOURCE ,DREG  70 +CYCLES
  624.     ELSE  8?  ." and"  .SIZE
  625.         IF     .DREG  ,SOURCE  8 4 
  626.         ELSE   .SOURCE ,DREG   4 2  
  627.         THEN   +IF-LONG 
  628.     THEN  ;
  629.  
  630. : .EXG    ." exg" >ARG ;
  631.  
  632. : NIB12  ( --- ) OPP/9 OPP   DUP $ 1F8 AND
  633.   CASE
  634.     $ 188  OF  .EXG  .AREG ,DREG  ENDOF
  635.     $ 148  OF  .EXG  .AREG ,AREG  ENDOF
  636.     $ 140  OF  .EXG  .DREG ,DREG  ENDOF
  637.       >R  ( OP-9-ROT OPP  )  OPP   $ 1F0 AND $ 100 =
  638.       IF   3?    ." abcd"  .BYTE  ( ... op9-rot opp flag )
  639.            IF      .-A@ .,  .-A@  [ DECIMAL ]  18 
  640.            ELSE  .DREG ,DREG  8   
  641.            THEN  +CYCLES 
  642.       ELSE  DDROP .MUL
  643.       THEN  RDROP EXIT 
  644.    ENDCASE  6 +CYCLES ;
  645.  
  646. \ 00001 fix "rot" -> "ro"
  647. 4 $TABLE  .ROT$  "as"  "ls" "rox" "ro"
  648.  
  649. : .ROTLR  ( --- )   3 AND  .ROT$  8?
  650.     IF    ASCII l  
  651.     ELSE  ASCII r   
  652.     THEN  EMIT  ;
  653.  
  654. : NIB14 (  --- ) 6&7?
  655.     IF    OPP/9  .ROTLR  1 size$ ( 00001 ) .SOURCE
  656.           8 +CYCLES
  657.     ELSE  OPP/3  .ROTLR  .SIZE  ( REG )  OPP/9  5?
  658.           IF    .DREG             
  659.           ELSE  7 AND  .#  .NUM   
  660.           THEN   OPP ,DREG   6 2 +IF-LONG 
  661.    THEN   ;
  662.  
  663. DECIMAL
  664. : NIB13  ( --- ) OPP/9
  665.  CONDITION  OPP $ C0 AND $ C0 =  ( OPP/9  FLAG )
  666.    IF    ." adda"  8? 1+ DISM-SIZE ! .SIZE  .SOURCE ,AREG  
  667.          8 +CYCLES  -2 +MEM 
  668.    ELSE  OPP  $ 130 AND $ 100 =
  669.    IF      ." addx"  .SIZE  ( OP/9 ) OPP  3?
  670.            IF      .-A@  .,   .-A@   18 12 
  671.            ELSE  .DREG      ,DREG         4   4 
  672.            THEN   +IF-LONG 
  673.    ELSE    ." add"  .SIZE   8?
  674.            IF    ( ->DN )   .DREG   ,SOURCE  4 2 ( +2 IF DN )  APPROX ON 
  675.            ELSE  ( => EA )  .SOURCE ,DREG    4 2  
  676.            THEN   +IF-LONG 
  677.    ENDCOND  ;
  678.  
  679. DECIMAL 16 FIG-VAR DISM-BASE
  680. UNCODE DEFINITIONS
  681. TRUE FIG-VAR .DISM#
  682.  
  683. : .ADDRESS   ( --- ) ( .DISM# @ )
  684.     ( IF )   BASE @ >R DISM-BASE @ BASE !  CR 0 OUT !
  685.              DISM-ADR @ .ADR    R> BASE !
  686.     ( THEN ) OPCODE-COL @ COLUMN  ;
  687.  
  688. : .16bit ( n1 -- )
  689.   4 0
  690.   DO    dup $ f000 and  -12 shift .hx  4 shift
  691.   LOOP  drop  ;
  692.  
  693. : .CODES ( ADR --- )  .DISM# @
  694.     IF    CODE-COL @ COLUMN     DISM-ADR @ SWAP
  695.           DO       I W@  ( 5 .R )  space .16bit
  696.           2 +LOOP  
  697.     ELSE DROP
  698.     THEN  ;
  699.  
  700. : .:   ( --- )  ." :" ;
  701. variable  CLOCK 7 CLOCK ! 
  702. variable  TOTAL-CYCLES 
  703.  
  704. : .CYCLES  ( op-adr --- )
  705.   CYCLE-COL @ COLUMN
  706.   SHOW-CYCLES @
  707.   IF
  708.      drop  ( -- )  .(  #CYCLES @ 2 .R  #CYCLES/ @ DUP 
  709.      IF
  710.         DUP  ." +" 0 .R ." /" 
  711.      THEN
  712.      DROP .: #CYCLES @ TOTAL-CYCLES @ + 
  713.      DUP TOTAL-CYCLES !    3 .R   TOTAL-CYCLES @ CLOCK @ / .: 2 .R  
  714.      .) APPROX @
  715.      IF
  716.         ASCII ? EMIT      
  717.      THEN ( FINAL-COL @ COLUMN )
  718.   ELSE
  719.      ascii " emit
  720.      dism-adr @ swap
  721.      DO
  722.         i c@  dup ?visible 0=
  723.         IF
  724.            drop ascii .
  725.         THEN
  726.         emit
  727.      LOOP
  728.      ascii " emit
  729.   THEN   ;
  730.  
  731. ONLY FORTH ALSO UNCODE DEFINITIONS 
  732. DECIMAL
  733.  
  734. : INIT-DISM-WORD  ( ADR --- )  DISM-ADR !  
  735.   .ADDRESS  
  736.    DISM-ADR @ ?EVEN W@ OPCODE !
  737.    NEW-DISM-ADR OFF
  738.    #CYCLES      OFF
  739.    #CYCLES/     OFF
  740.    APPROX       OFF
  741.    MEM          OFF
  742.    DOING-CALL   OFF
  743.    dc.w?        off ;
  744.  
  745. ONLY FORTH UNCODE ALSO FORTH DEFINITIONS
  746. : DISM-DONE? ( --- FLAG )   NEW-DISM-ADR @
  747.      IF   NEW-DISM-ADR @  ?EVEN DISM-ADR     !  
  748.           NEW-DISM-ADR OFF
  749.      THEN  DISM-DONE @  ;
  750.  
  751. 1 .IF
  752.  
  753. \ Thanx to Marty Kees for the 68881 support...   start 00002
  754.  
  755. : .68881   ( --- )
  756.   BEGIN  out @  opcode-col @ >
  757.   WHILE  bsout @ emit
  758.   REPEAT 
  759.   ." 68881{ " >ARG  OPP .num   
  760.   OPP $ F23C =
  761.   IF
  762.      dism-adr @ 2+ w@ $ 1c00 and -10 shift
  763.      CASE       \ size of immediate + 4 byte opcode
  764.         0 OF 8  \ .l long
  765.           ENDOF
  766.         1 OF 8  \ .s single
  767.           ENDOF
  768.         2 OF 16 \ .x extended
  769.           ENDOF
  770.         3 OF 16 \ .p packed d r
  771.           ENDOF
  772.         4 OF 6  \ .w word
  773.           ENDOF
  774.         5 OF 12 \ .d double
  775.           ENDOF 
  776.         6 OF 6  \ .b byte but stored as word
  777.           ENDOF
  778.         4 swap
  779.       ENDCASE
  780.       2- dup dism-adr @ + ?even dism-adr ! 
  781.       dism-size !
  782.   ELSE
  783.       a2+
  784.   THEN
  785.   DC.W? ON   
  786. ;
  787.  
  788. : DISM-WORD?  ( Adr --- Adr+ Flag )
  789.   (COMMAS) @ >R NO-COMMAS INIT-DISM-WORD   ( -- )
  790.   BASE @ >R DISM-BASE @ BASE !   DISM-ADR @  >R  
  791.     SET-SIZE  12 4 @OPP-BITS
  792.     SELECT
  793.        NIB0 NIB1-3  NIB1-3  NIB1-3 NIB4   NIB5  NIB6  .MOVEQ
  794.        NIB8 NIB9    .DW     NIB11  NIB12  NIB13 NIB14 .68881
  795.     END-SELECT  A2+ 
  796.   R@ .CODES DECIMAL r> .CYCLES  R> BASE ! DISM-ADR @ DISM-DONE? 
  797.   R> (COMMAS) !  3 X>R ?PAUSE 3 XR> 
  798. ;    \ end 00002
  799.  
  800. .ELSE
  801.  
  802. : DISM-WORD?  ( Adr --- Adr+ Flag )
  803.   (COMMAS) @ >R NO-COMMAS INIT-DISM-WORD   ( -- )
  804.   BASE @ >R DISM-BASE @ BASE !   DISM-ADR @  >R  
  805.     SET-SIZE  12 4 @OPP-BITS
  806.     SELECT
  807.        NIB0 NIB1-3  NIB1-3  NIB1-3 NIB4   NIB5  NIB6  .MOVEQ
  808.        NIB8 NIB9    .DW     NIB11  NIB12  NIB13 NIB14 .DW
  809.     END-SELECT  A2+ 
  810.   R@ .CODES DECIMAL r> .CYCLES  R> BASE ! DISM-ADR @ DISM-DONE? 
  811.   R> (COMMAS) !  3 X>R ?PAUSE 3 XR> ;
  812.  
  813. .THEN
  814.  
  815. : INIT-DISM ( FROM --- ) ?EVEN  START-ADR !  
  816.    $ -8000,0000 HIGH-BRANCH !
  817.    DISM-DONE     OFF 
  818.    TOTAL-CYCLES  OFF  ;
  819.  
  820. ONLY FORTH DEFINITIONS
  821.  
  822. false FIG-VAR DISM-CYCLES     TRUE FIG-VAR DISM-NAMES
  823.  
  824. : SELECT-DISM-DEFAULTS  ( -- , select the system default dism state )
  825.   [ ALSO UNCODE ]   DISM-CYCLES @ SHOW-CYCLES !
  826.                     DISM-NAMES  @ .REGNAMES?  !   [ PREVIOUS ]  ;
  827.  
  828. ONLY FORTH ALSO UNCODE DEFINITIONS
  829. : <DISM>  ( ADR --- )  DUP INIT-DISM
  830.     SELECT-DISM-DEFAULTS
  831.     BEGIN   DISM-WORD? 
  832.     UNTIL   DROP  CR  ;
  833.  
  834. ONLY FORTH UNCODE ALSO FORTH DEFINITIONS
  835.  
  836. : DISM  ( ADR --- )
  837.   DISM-ORIGIN OFF  <DISM> ;
  838.  
  839. : RELDISM  ( origin-adr dism-adr -- )
  840.   swap DISM-ORIGIN !  <DISM>  ;
  841.  
  842. : RISM  ( ADR --- ) ( * RELATIVE DISM )
  843.   DUP DISM-ORIGIN !  <DISM> ;
  844.  
  845. : ADISM  ( abs-adr --- )
  846.   DUP >REL SWAP OVER - NEGATE DISM-ORIGIN ! <DISM> ;
  847.  
  848. .NEED $SKIP
  849. : $SKIP  ( ADR --- ADR' )  DUP $SIZE + ;
  850. .THEN
  851.  
  852. ( 00005 )  variable THE-CFA
  853. DECIMAL 
  854.  
  855. : DEF  ( --- )    SELECT-DISM-DEFAULTS
  856.     DISM-ORIGIN OFF
  857.     [COMPILE]  '     BASE @ >R  HEX   
  858.     DUP   DUP>R     DUP INIT-DISM 
  859.     BEGIN  DUP   W@ ( adr opcode )  
  860.  
  861.            CONDITION DUP BSR-CODE =
  862.                IF   drop dup 2+ dup w@ w->s + THE-CFA !
  863.                ELSE DUP  jsr-code  =
  864.                IF   drop dup 2+ @ >rel THE-CFA !
  865.                ELSE DUP JSR+64K-CODE =
  866.                IF   drop dup 2+ w@ w->s $ 1,0000 + THE-CFA !
  867.                ELSE DUP JSR+ORG-CODE =
  868.                IF   drop dup 2+ w@ w->s THE-CFA !
  869.                ELSE drop THE-CFA OFF
  870.            ENDCOND  
  871.              1 rpick base !   
  872.              DISM-WORD?  
  873.              hex
  874.              >R  THE-CFA @ ' (.")       = 
  875.                  THE-CFA @ ' ($")       =  OR 
  876.                  THE-CFA @ ' (?ABORT")  =  OR
  877.            IF       cr CR  ." '"  DUP $TYPE $SKIP ." '"  CR
  878.            THEN R> 
  879.     UNTIL 2DROP r@ >NAME  
  880.     >newline  cr dup id. ."  is "  IMMEDIATE?  
  881.     IF    ." IMMEDIATE, "
  882.     THEN  r> r> base !   
  883.     dup  DISM-ADR @ - ABS  dup 1 .r ."  bytes long ("  
  884.           CELL/ .  ." cells), defined as '"
  885.           CELL- @
  886.           CONDITION
  887.             dup 0<              IF   drop ." inline'"  ELSE
  888.             dup $ 4000,0000 and IF   drop ." called'"  ELSE
  889.             drop ." both'"
  890.           ENDCOND
  891.     CR CR   ;
  892.  
  893. : SEE DEF ;
  894. only forth definitions
  895. DECIMAL
  896.  
  897.  
  898.